#!/usr/local/bin/perl
use LWP::Simple qw(get);
use FreeBSD::Ports::INDEXhash qw/INDEXhash/;
use Data::Dumper;
use CPANPLUS::Backend;
use Getopt::Std;
use strict;

my %opt;
getopts('vdL:l:p:', \%opt);

my $cb = new CPANPLUS::Backend;
my %hash = INDEXhash();

my %SIGN = (
  1 => '>',
  0 => '=',
  -1 => '<',
);
my %DESC = (
  1 => 'succeeds CPAN (CPAN has %s)',
  0 => 'up-to-date with CPAN',
  -1 => 'needs update (CPAN has %s)',
);
undef($CPANPLUS::Error::ERROR_FH);

foreach my $name (sort keys %hash)
{
  next if $name =~ m{^\w\w-p5-};
  my $module;
  $module = $1 if ($name =~ m{^p5-(.+)-\d\.?\w*$});
  $module = $1 if ($hash{$name}{'www'} =~ m{cpan.org.*/([^/]+)/?});
  next if !$module;
  if ($hash{$name}{'www'} !~ m{cpan.org})
  {
    #warn "No CPAN page for name: $name, www: $hash{$name}{'www'}, use http://search.cpan.org/dist/$module instead\n";
    $hash{$name}{'www'} = 'http://search.cpan.org/dist/' . $module;
  }
  next if $opt{p} && $module !~ m{$opt{p}};
  print "name: $name module: $module\n" if $opt{d};
  my $mod = $cb->parse_module(module => $module) || warn "$module not found\n" && next;
  print Dumper($mod) if $opt{d};
  my $sign = '!';
  my $desc = 'Comparison failed';
  #my $p = $1 if ($name =~ m{-([\d\.]+[a-zA-Z]*)([,_]\d+)*$}) || die $name;
  my $p = $1 if ($name =~ m{-([\w\.\+]+?)([,_]\d+)*$}) || die $name;
  my $c = $mod->version;
  $c = $1 if ($c == 0 && $mod->package =~ m{-([\d\._]+)\.(t(ar\.)?(b|g)z)});
  next if $c == 0;
  my @V = ($p, $c);
  my $_cmp = _cmp($p, sort CMP @V);
  if ($_cmp != 0 && $hash{$name}{'www'} =~ m{cpan})
  {
    printf("GET %s\n", $hash{$name}{'www'}) if $opt{d};
    my $page = get($hash{$name}{'www'});
    $page =~ s{(\r|\n)}{}g;
    if ($page !~ m{cannot be found})
    {
      $c = $1 if $page =~ m{This Release.*?-v?(([\d\.]+[a-zA-Z]*)([,_]\d+)*)<};
      die $hash{$name}{'www'} if !$c;
      @V = ($p, $c);
      $_cmp = _cmp($p, sort CMP @V);
    }
  }
  print "_cmp: $_cmp\n" if $opt{d};
  $sign = $SIGN{$_cmp};
  $desc = sprintf($DESC{$_cmp}, $c);
  $desc = "" if !$opt{v};
  next if $opt{L} && $opt{L} eq $sign;
  next if $opt{l} && $opt{l} ne $sign;
  my $star = ' ';
  my $x;
  foreach my $rdep (@{$hash{$name}{'Rdeps'}})
  {
    $x++ if $sign ne '=';
    $x++ if $rdep =~ m{^p5-Test-Simple} && $name !~ m{^p5-Test};
    $x++ if $rdep =~ m{^p5-PathTools};
    $x++ if $rdep =~ m{^p5-Time-HiRes};
    $x++ if $rdep =~ m{^p5-Time-Local};
    $x++ if $rdep =~ m{^p5-MIME-Base64};
    $x++ if $rdep =~ m{^p5-Scalar-List-Utils};
  }
  if ($x)
  {
    $star = '*%' if $x;
    $star = '*?' if -d "/var/db/pkg/$name";
    $star = '*!' if $hash{$name}{'maintainer'} =~ m{^(leeym|perl|ports)\@FreeBSD.org}i;
  }
  my $path = $hash{$name}{'path'};
  $path =~ s{/usr/ports/}{};
  my $misc = sprintf(" %s %s", $path, $hash{$name}{'maintainer'}) if $star ne ' ' or $sign eq '<';
  my $debug = sprintf(" $p <=> $c\n") if $opt{d};
  printf("%-35s %s%s\t%s%s\n", $name, $sign, $star, $desc, $misc, $debug);
};

sub ver
{
  my $src = shift;
  my ($M, $m) = split(/\./, $src, 2);
  $m =~ s{[_,]\d+}{}g;
  $m =~ s{\.}{}g;
  $m =~ s{(\d[A-Za-z])[a-z]*$}{\1}g;
  $m = sprintf("%d%d", $1, $2) if $m =~ m{^(\d{3})(\d{3})$};
  $m =~ s{0*$}{}g;
  return "$M.$m";
}

sub CMP
{
  $a = ver($a);
  $b = ver($b);
  my ($a1, $a2) = split(/\./, $a, 2);
  my ($b1, $b2) = split(/\./, $b, 2);
  my $len = max(length($a2), length($b2));
  $a2 .= 0 while (length($a2) < $len);
  $b2 .= 0 while (length($b2) < $len);
  my $_a = "$a1.$a2";
  my $_b = "$b1.$b2";
  print "$a <=> $b   ===>   $_a <=> $_b\n" if $opt{d};
  return $_a <=> $_b;
}

sub _cmp
{
  my $v = shift;
  my @V = @_;
  my $ret = 0;
  print Dumper(\@V) if $opt{d};
  $ret-- if (ver($v) eq ver($V[0]));
  $ret++ if (ver($v) eq ver($V[1]));
  return $ret;
}

sub max
{
  return (sort(@_))[-1];
}

sub min
{
  return (sort(@_))[0];
}
